Usenet 1993 July

home *** CD-ROM | disk | FTP | other *** search

/ Usenet 1993 July / InfoMagic USENET CD-ROM July 1993.ISO / sources / unix / volume10 / ptoc / part09 < prev next >

Wrap

Internet Message Format | 1987-07-27 | 53.3 KB

Path: uunet!rs From: rs@uunet.UU.NET (Rich Salz) Newsgroups: comp.sources.unix Subject: v10i073: Pascal to C translator, Part09/12 Message-ID: <724@uunet.UU.NET> Date: 28 Jul 87 19:36:15 GMT Organization: UUNET Communications Services, Arlington, VA Lines: 2548 Approved: rs@uunet.UU.NET Submitted-by: Per Bergsten <mcvax!enea!chalmers!holtec!perb> Posting-number: Volume 10, Issue 73 Archive-name: ptoc/Part09 #! /bin/sh # This is a shell archive. Remove anything before this line, then unpack # it by saving it into a file and typing "sh file". To overwrite existing # files, type "sh file -c". You can also feed this as standard input via # unshar, or by typing "sh <file", e.g.. If this archive is complete, you # will see the following message at the end: # "End of archive 9 (of 12)." # Contents: ptc.p.3 PATH=/bin:/usr/bin:/usr/ucb ; export PATH if test -f 'ptc.p.3' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'ptc.p.3'\" else echo shar: Extracting \"'ptc.p.3'\" $50280 characters$ sed "s/^X//" >'ptc.p.3' <<'END_OF_FILE' X tx^.tto := ty^.thi X end X else if ty^.tt = nscalar then X begin X ty := ty^.tscalid; X tx^.tfrom := ty; X while ty^.tnext <> nil do X ty := ty^.tnext; X tx^.tto := ty X end X else if ty = typnods[tchar] then X begin X currsym.st := schar; X currsym.vchr := chr(minchar); X tx^.tfrom := mklit; X currsym.st := schar; X currsym.vchr := chr(maxchar); X tx^.tto := mklit X end X else if ty = typnods[tinteger] then X begin X currsym.st := sinteger; X currsym.vint := -maxint; X tx^.tfrom := mklit; X currsym.st := sinteger; X currsym.vint := maxint; X tx^.tto := mklit X end X else X fatal(etree); X tx^.tforstmt := tz; X tx^.tincr := true X end; X npredef, X nfileof: X if opn then X begin X (* create file-struct initialization *) X ty := mknode(nselect); X ty^.trecord := ti; X ty^.tfield := X oldid(defnams[dzinit]^.lid, X lforward); X tx := mknode(nassign); X tx^.tlhs := ty; X currsym.st := sinteger; X currsym.vint := 0; X tx^.trhs := mklit X end X else begin X (* create file-struct wrapup *) X tx := mknode(ncall); X tx^.tcall := X oldid(defnams[dclose]^.lid, X lidentifier); X tx^.taparm := ti X end; X nrecord: X begin X ty := nil; X tq := tq^.tflist; X while tq <> nil do X begin X if filevar(typeof(tq^.tbind)) then X begin X tz := tq^.tidl; X while tz <> nil do X begin X tx := mknode(nselect); X tx^.trecord := ti; X tx^.tfield := tz; X tx := fileinit(tx, X typeof(tq^.tbind), X opn); X tx^.tnext := ty; X ty := tx; X tz := tz^.tnext X end X end; X tq := tq^.tnext X end; X tx := mknode(nbegin); X tx^.tbegin := ty X end; X end;(* case *) X fileinit := tx X end; X X begin (* initcode *) X while tp <> nil do X begin X initcode(tp^.tsubsub); X tv := tp^.tsubvar; X while tv <> nil do X begin X tq := typeof(tv^.tbind); X if filevar(tq) then X begin X ti := tv^.tidl; X while ti <> nil do X begin X tu := fileinit(ti, tq, true); X linkup(tp, tu); X tu^.tnext := tp^.tsubstmt; X tp^.tsubstmt := tu; X while tu^.tnext <> nil do X tu := tu^.tnext; X tu^.tnext := fileinit(ti, tq, X false); X linkup(tp, tu^.tnext); X ti := ti^.tnext X end X end; X tv := tv^.tnext; X end; X tp := tp^.tnext X end X end; (* initcode *) X Xbegin (* transform *) X renamc; X renamp(top^.tsubsub, false); X extract(top); X renamf(top); X initcode(top^.tsubsub); X global(top, top, false) Xend; (* transform *) X X(* Emit C-code for program or module. *) Xprocedure emit; X Xconst include = '# include '; X define = '# define '; X ifdef = '# ifdef '; X ifndef = '# ifndef '; X elsif = '# else'; X endif = '# endif'; X static = 'static '; X xtern = 'extern '; X typdef = 'typedef '; X registr = 'register '; X usigned = 'unsigned '; X indstep = 8; X Xvar conflag, X setused, X dropset, X donearr : boolean; X doarrow, X indnt : integer; X X procedure increment; X begin X indnt := indnt + indstep X end; X X procedure decrement; X begin X indnt := indnt - indstep X end; X X (* Write tabs/blanks to properly (?) indent C-code. *) X procedure indent; X X var i : integer; X X begin X i := indnt; X (* limit indent to an integral number of tabs *) X if i > 60 then X i := i div tabwidth * tabwidth; X while i >= tabwidth do X begin X write(tab1); X i := i - tabwidth X end; X while i > 0 do X begin X write(space); X i := i - 1 X end; X end; X X (* Determine if tp must be cast to an integer before being *) X (* used in an arithmetic expression. *) X function arithexpr(tp : treeptr) : boolean; X X begin X tp := typeof(tp); X if tp^.tt = nsubrange then X if tp^.tup^.tt = nconfarr then X tp := typeof(tp^.tup^.tindtyp) X else X tp := typeof(tp^.tlo); X arithexpr := (tp = typnods[tinteger]) or X (tp = typnods[tchar]) or X (tp = typnods[treal]) X end; X X procedure eexpr(tp : treeptr); forward; X procedure etypedef(tp : treeptr); forward; X X (* Emit code to select a record member. *) X procedure eselect(tp : treeptr); X X begin X doarrow := doarrow + 1; X eexpr(tp); X doarrow := doarrow - 1; X if donearr then X donearr := false X else X write('.') X end; X X (* Emit code for call to a predefined function/procedure. *) X procedure epredef(ts, tp : treeptr); X X label 444, 555; X X var tq, X tv, tx : treeptr; X td : predefs; X nelems : integer; X ch : char; X txtfile : boolean; X X (* Determine a format-code for fprintf. *) X (* Update nelems as a sideeffect. *) X function typeletter(tp : treeptr) : char; X X label 999; X X var tq : treeptr; X X begin X tq := tp; X if tq^.tt = nformat then X begin X if tq^.texpl^.tt = nformat then X begin X typeletter := 'f'; X goto 999 X end; X tq := tp^.texpl X end; X tq := typeof(tq); X if tq^.tt = nsubrange then X tq := typeof(tq^.tlo); X if tq = typnods[tstring] then X typeletter := 's' X else if tq = typnods[tinteger] then X typeletter := 'd' X else if tq = typnods[tchar] then X typeletter := 'c' X else if tq = typnods[treal] then X if tp^.tt = nformat then X typeletter := 'e' X else X typeletter := 'g' X else if tq = typnods[tboolean] then X begin X typeletter := 'b'; X nelems := 6 X end X else if tq^.tt = narray then X begin X typeletter := 'a'; X nelems := crange(tq^.taindx) X end X else if tq^.tt = nconfarr then X begin X typeletter := 'v'; X nelems := 0 X end X else X fatal(etree); X 999: X end; (* typeletter *) X X procedure etxt(tp : treeptr); X X var w : toknbuf; X c : char; X i : toknidx; X X begin X case tp^.tt of X nid: X begin X tp := idup(tp); X if tp^.tt = nconst then X etxt(tp^.tbind) X else X fatal(etree) X end; X nstring: X begin X (* printf format string *) X gettokn(tp^.tsym^.lstr, w); X i := 1; X while w[i] <> chr(null) do X begin X c := w[i]; X if (c = cite) or (c = bslash) then X write(bslash) X else if c = percent then X write(percent); X write(c); X i := i + 1 X end X end; X nchar: X begin X (* single character in printf format *) X c := tp^.tsym^.lchar; X if (c = cite) or (c = bslash) then X write(bslash) X else if c = percent then X write(percent); X write(c) X end; X end;(* case *) X end; (* etxt *) X X (* Emit format for fprintf. *) X procedure eformat(tq : treeptr); X X var tx : treeptr; X i : integer; X X begin X case typeletter(tq) of X 'a': X begin X write(percent); X if tq^.tt = nformat then X if tq^.texpr^.tt = ninteger then X eexpr(tq^.texpr) X else X write('*'); X write('.', nelems:1, 's') X end; X 'b': X begin X write(percent); X if tq^.tt = nformat then X begin X if tq^.texpr^.tt = ninteger then X eexpr(tq^.texpr) X else X write('*') X end; X write('s') X end; X 'c': X if tq^.tt = nchar then X etxt(tq) X else begin X write(percent); X if tq^.tt = nformat then X if tq^.texpr^.tt = ninteger then X eexpr(tq^.texpr) X else X write('*'); X write('c') X end; X 'd': X begin X write(percent); X if tq^.tt = nformat then X begin X if tq^.texpr^.tt = ninteger then X eexpr(tq^.texpr) X else X write('*') X end X else X write(intlen:1); X write('d') X end; X 'e': X begin X write(percent, space); X tx := tq^.texpr; X if tx^.tt = ninteger then X begin X i := cvalof(tx); X write(i:1, '.'); X i := i - 7; X if i < 1 then X write('1') X else X write(i:1) X end X else X write('*.*'); X write('e') X end; X 'f': X begin X write(percent); X tx := tq^.texpl; X if tx^.texpr^.tt = ninteger then X begin X eexpr(tx^.texpr); X write('.'); X tx := tq^.texpr; X if tx^.tt = ninteger then X begin X i := cvalof(tx); X tx := tq^.texpl^.texpr; X if i > cvalof(tx) - 1 then X write('1') X else X write(i:1) X end X else X write('*'); X end X else X write('*.*'); X write('f') X end; X 'g': X write(percent, fixlen:1, 'e'); X 's': X if tq^.tt = nstring then X etxt(tq) X else begin X write(percent); X if tq^.tt = nformat then X if tq^.texpr^.tt = ninteger then X eexpr(tq^.texpr) X else X write('*.*'); X write('s') X end X end (* case *) X end; (* eformat *) X X (* Emit parameters to fprintf except format. *) X procedure ewrite(tq : treeptr); X X var tx : treeptr; X X begin X case typeletter(tq) of X 'a': X begin X write(', '); X tx := tq; X if tq^.tt = nformat then X begin X if tq^.texpr^.tt <> ninteger then X begin X eexpr(tq^.texpr); X write(', ') X end; X tx := tq^.texpl X end; X eexpr(tx); X write('.A') X end; X 'b': X begin X write(', '); X tx := tq; X if tq^.tt = nformat then X begin X if tq^.texpr^.tt <> ninteger then X begin X eexpr(tq^.texpr); X write(', ') X end; X tx := tq^.texpl X end; X usebool := true; X write('Bools[(int)('); X eexpr(tx); X write(')]') X end; X 'c': X begin X if tq^.tt = nformat then X begin X if tq^.texpr^.tt <> ninteger then X begin X write(', '); X eexpr(tq^.texpr) X end; X write(', '); X eexpr(tq^.texpl) X end X else if tq^.tt <> nchar then X begin X write(', '); X eexpr(tq) X end X end; X 'd': X begin X write(', '); X tx := tq; X if tq^.tt = nformat then X begin X if tq^.texpr^.tt <> ninteger then X begin X eexpr(tq^.texpr); X write(', ') X end; X tx := tq^.texpl X end; X eexpr(tx) X end; X 'e': X begin X write(', '); X tx := tq^.texpr; X if tx^.tt <> ninteger then X begin X usemax := true; X eexpr(tx); X write(', Max('); X eexpr(tx); X write(' - 7, 1), ') X end; X eexpr(tq^.texpl) X end; X 'f': X begin X write(', '); X tx := tq^.texpl; X if tx^.texpr^.tt <> ninteger then X begin X eexpr(tx^.texpr); X write(', ') X end; X if (tx^.texpr^.tt <> ninteger) or X (tq^.texpr^.tt <> ninteger) then X begin X usemax := true; X write('Max(('); X eexpr(tx^.texpr); X write(') - ('); X eexpr(tq^.texpr); X write(') - 1, 1), ') X end; X eexpr(tq^.texpl^.texpl) X end; X 'g': X begin X write(', '); X eexpr(tq) X end; X 's': X begin X if tq^.tt = nformat then X begin X if tq^.texpr^.tt <> ninteger then X begin X write(', '); X eexpr(tq^.texpr); X write(', '); X eexpr(tq^.texpr) X end; X write(', '); X eexpr(tq^.texpl) X end X else if tq^.tt <> nstring then X begin X write(', '); X eexpr(tq) X end X end X end (* case *) X end; (* ewrite *) X X (* Emit size of *tp for call to malloc. CPU *) X (* There is no safe way to compute the size of a *) X (* particular variant of a C-union, we assume that *) X (* the size can be computed by taking the address *) X (* of the first member and subracting the address *) X (* of the record and then adding the size of the *) X (* variant containing the record. *) X procedure enewsize(tp : treeptr); X X label 555; X X var tq, tx, ty : treeptr; X v : integer; X X (* Emit size of union member tq. *) X procedure esubsize(tp, tq : treeptr); X X label 555, 666; X X var tx, ty : treeptr; X addsize : boolean; X X begin X tx := tq^.tvrnt; X ty := tx^.tflist; X if ty = nil then X begin X ty := tx^.tvlist; X while ty <> nil do X begin X if ty^.tvrnt^.tflist <> nil then X begin X ty := ty^.tvrnt^.tflist; X goto 555 X end; X ty := ty^.tnext X end; X 555: X end; X addsize := true; X if ty = nil then X begin X (* empty variant, try using another *) X addsize := false; X ty := tx^.tup^.tup^.tvlist; X while ty <> nil do X begin X if ty^.tvrnt^.tflist <> nil then X begin X ty := ty^.tvrnt^.tflist; X goto 666 X end; X ty := ty^.tnext X end; X 666: X end; X if ty = nil then X begin X (* its getting too complicated, X ignore tag value *) X write('sizeof(*'); X eexpr(tp); X write(')') X end X else begin X (* compute offset to first member of X the selected union variant *) X write('Unionoffs('); X eexpr(tp); X write(', '); X printid(ty^.tidl^.tsym^.lid); X if addsize then X begin X (* add the size of the selected X union variant *) X write(') + sizeof('); X eexpr(tp); X write('->'); X printid(tx^.tuid) X end; X write(')') X end X end; X X begin (* newsize *) X if (tp^.tnext <> nil) and unionnew then X begin X (* tnext points to a tag-value, evaluate it *) X v := cvalof(tp^.tnext); X (* find union type *) X tq := typeof(tp); X tq := typeof(tq^.tptrid); X if tq^.tt <> nrecord then X fatal(etree); X (* find corresponding variant *) X tx := tq^.tvlist; X while tx <> nil do X begin X ty := tx^.tselct; X while ty <> nil do X begin X if v = cvalof(ty) then X goto 555; X ty := ty^.tnext X end; X tx := tx^.tnext X end; X fatal(etag); X 555: X (* emit size for that variant *) X esubsize(tp, tx) X end X else begin X write('sizeof(*'); X eexpr(tp); X write(')') X end X end; (* newsize *) X X begin (* epredef *) X td := ts^.tsubstmt^.tdef; X case td of X dabs: X begin X tq := typeof(tp^.taparm); X if (tq = typnods[tinteger]) or (tq^.tt = nsubrange) then X write('abs(') (* LIB *) X else X write('fabs('); (* LIB *) X eexpr(tp^.taparm); X write(')') X end; X dargv: X begin X write('Argvgt('); X eexpr(tp^.taparm); X write(', '); X eexpr(tp^.taparm^.tnext); X write('.A, sizeof('); X eexpr(tp^.taparm^.tnext); X writeln('.A));') X end; X dchr: X begin X tq := typeof(tp^.taparm); X if tq^.tt = nsubrange then X if tq^.tup^.tt = nconfarr then X tq := typeof(tq^.tup^.tindtyp) X else X tq := typeof(tq^.tlo); X if (tq = typnods[tinteger]) or X (tq = typnods[tchar]) then X eexpr(tp^.taparm) X else begin X write('(char)('); X eexpr(tp^.taparm); X write(')') X end X end; X ddispose: X begin X write('free('); (* LIB *) X eexpr(tp^.taparm); X writeln(');') X end; X deof: X begin X write('Eof('); X if tp^.taparm = nil then X begin X defnams[dinput]^.lused := true; X printid(defnams[dinput]^.lid) X end X else X eexpr(tp^.taparm); X write(')') X end; X deoln: X begin X write('Eoln('); X if tp^.taparm = nil then X begin X defnams[dinput]^.lused := true; X printid(defnams[dinput]^.lid) X end X else X eexpr(tp^.taparm); X write(')'); X end; X dexit: X begin X write('exit('); (* OS *) X if tp^.taparm = nil then X write('0') X else X eexpr(tp^.taparm); X writeln(');'); X end; X dflush: X begin X write('fflush('); (* LIB *) X if tp^.taparm = nil then X begin X defnams[doutput]^.lused := true; X printid(defnams[doutput]^.lid) X end X else X eexpr(tp^.taparm); X writeln('.fp);') X end; X dpage: X begin X (* write form-feed character *) X write('Putchr(', ffchr, ', '); (* CHAR *) X if tp^.taparm = nil then X begin X defnams[doutput]^.lused := true; X printid(defnams[doutput]^.lid) X end X else X eexpr(tp^.taparm); X writeln(');'); X end; X dput, X dget: X begin X if typeof(tp^.taparm) = typnods[ttext] then X if td = dget then X write('Getx') X else X write('Putx') X else begin X write(voidcast); X if td = dget then X write('Get') X else X write('Put') X end; X write('('); X eexpr(tp^.taparm); X writeln(');') X end; X dhalt: X writeln('abort();'); (* OS *) X dnew: X begin X eexpr(tp^.taparm); X write(' = ('); X etypedef(typeof(tp^.taparm)); X write(')malloc((unsigned)('); (* LIB *) X enewsize(tp^.taparm); X writeln('));') X end; X dord: X begin X write('(unsigned)('); X eexpr(tp^.taparm); X write(')') X end; X dread, X dreadln: X begin X txtfile := false; X tq := tp^.taparm; X if tq <> nil then X begin X tv := typeof(tq); X if tv = typnods[ttext] then X begin X (* reading from textfile *) X txtfile := true; X tv := tq; X tq := tq^.tnext X end X else if tv^.tt = nfileof then X begin X (* reading from other file *) X txtfile := typeof(tv^.tof) = X typnods[tchar]; X tv := tq; X tq := tq^.tnext X end X else begin X (* reading from std-input *) X txtfile := true; X tv := nil X end X end X else begin X tv := nil; X txtfile := true X end; X if txtfile then X begin X (* check for special case *) X if tq = nil then X goto 444; X if (tq^.tt <> nformat) and X (tq^.tnext = nil) and X (typeletter(tq) = 'c') then X begin X (* read single char *) X eexpr(tq); X write(' = '); X write('Getchr('); X if tv = nil then X printid(defnams[dinput]^.lid) X else X eexpr(tv); X write(')'); X if td = dreadln then X write(','); X goto 444 X end; X usescan := true; X write('Fscan('); X if tv = nil then X printid(defnams[dinput]^.lid) X else X eexpr(tv); X write('), '); X (* first pass, emit format string *) X while tq <> nil do X begin X write('Scan(', cite); X ch := typeletter(tq); X case ch of X 'a': X write(percent, 's'); X 'c': X write(percent, 'c'); X 'd': X write(percent, 'ld'); X 'g': X write(percent, 'le') X end;(* case *) X write(cite, ', '); X case ch of X 'a': X begin X eexpr(tq); X write('.A') X end; X 'c': X begin X write('&'); X eexpr(tq) X end; X 'd': X write('&Tmplng'); X 'g': X write('&Tmpdbl') X end;(* case *) X write(')'); X case ch of X 'd': X begin X write(', '); X eexpr(tq); X write(' = Tmplng') X end; X 'g': X begin X write(', '); X eexpr(tq); X write(' = Tmpdbl') X end; X 'a', X 'c': X (* no op *) X end;(* case *) X tq := tq^.tnext; X if tq <> nil then X begin X writeln(','); X indent; X write(tab1) X end X end; X write(', Getx('); X if tv = nil then X printid(defnams[dinput]^.lid) X else X eexpr(tv); X write(')'); X if td = dreadln then X write(','); X 444: X if td = dreadln then X begin X usegetl := true; X write('Getl(&'); X if tv = nil then X printid(defnams[dinput]^.lid) X else X eexpr(tv); X write(')') X end X end X else begin X increment; X while tq <> nil do X begin X write(voidcast, 'Fread('); X eexpr(tq); X write(', '); X eexpr(tv); X write('.fp)'); X tq := tq^.tnext; X if tq <> nil then X begin X writeln(','); X indent X end X end; X decrement X end; X writeln(';') X end; X dwrite, X dwriteln, X dmessage: X begin X txtfile := false; X tq := tp^.taparm; X if tq <> nil then X begin X tv := typeof(tq); X if tv = typnods[ttext] then X begin X (* writing to textfile *) X txtfile := true; X tv := tq; X tq := tq^.tnext X end X else if tv^.tt = nfileof then X begin X (* writing to other file *) X txtfile := typeof(tv^.tof) = X typnods[tchar]; X tv := tq; X tq := tq^.tnext X end X else begin X (* writing to std-output *) X txtfile := true; X tv := nil X end X end X else begin X tv := nil; X txtfile := true X end; X if txtfile then X begin X (* check for special case *) X if tq = nil then X begin X (* writeln whithout parameters *) X if td in [dwriteln, dmessage] then X begin X write('Putchr(', nlchr, ', '); X if tv = nil then X printid( X defnams[doutput]^.lid) X else X eexpr(tv); X write(')') X end; X writeln(';'); X goto 555 X end X else if (tq^.tt <> nformat) and X (tq^.tnext = nil) then X if typeletter(tq) = 'c' then X begin X (* print single char *) X write('Putchr('); X eexpr(tq); X write(', '); X if tv = nil then X printid( X defnams[doutput]^.lid) X else X eexpr(tv); X write(')'); X if td = dwriteln then X begin X write(',Putchr(', X nlchr, ', '); X if tv = nil then X printid( X defnams[doutput]^.lid) X else X eexpr(tv); X write(')'); X end; X writeln(';'); X goto 555 X end; X tx := nil; X write(voidcast, 'fprintf('); (* LIB *) X if td = dmessage then X write('stderr, ') X else begin X if tv = nil then X printid(defnams[doutput]^.lid) X else X eexpr(tv); X write('.fp, ') X end; X write(cite); X tx := tq; (* remember 1:st parm *) X (* first pass, emit format string *) X while tq <> nil do X begin X eformat(tq); X tq := tq^.tnext X end; X if (td = dmessage) or (td = dwriteln) then X write('\n'); X write(cite); X (* second pass, add parameters *) X tq := tx; X while tq <> nil do X begin X ewrite(tq); X tq := tq^.tnext X end; X write('), Putl('); X if tv = nil then X printid(defnams[doutput]^.lid) X else X eexpr(tv); X if td = dwrite then X write(', 0)') X else X write(', 1)') X end X else begin X increment; X tx := typeof(tv); X if tx = typnods[ttext] then X tx := typnods[tchar] X else if tx^.tt = nfileof then X tx := typeof(tx^.tof) X else X fatal(etree); X while tq <> nil do X begin X if (tq^.tt in [nid, nindex, nselect, X nderef]) and X (tx = typeof(tq)) then X begin X write(voidcast, 'Fwrite('); X eexpr(tq) X end X else begin X if tx^.tt = nsetof then X begin X usescpy := true; X write('Setncpy('); X eselect(tv); X write('buf.S, '); X eexpr(tq); X if typeof(tp^.trhs) = X typnods[tset] then X eexpr(tq) X else begin X eselect(tq); X write('S') X end; X write(', sizeof('); X eexpr(tv); X write('.buf))'); X end X else begin X eexpr(tv); X write('.buf = '); X eexpr(tq) X end; X write(', Fwrite('); X eexpr(tv); X write('.buf'); X end; X write(', '); X eexpr(tv); X write('.fp)'); X tq := tq^.tnext; X if tq <> nil then X begin X writeln(','); X indent X end X end; X decrement X end; X writeln(';'); X 555: X end; X dclose: X begin X tq := typeof(tp^.taparm); X txtfile := tq = typnods[ttext]; X if (not txtfile) and (tq^.tt = nfileof) then X if typeof(tq^.tof) = typnods[tchar] then X txtfile := true; X if txtfile then X write('Closex(') X else X write('Close('); X eexpr(tp^.taparm); X writeln(');'); X end; X dreset, X drewrite: X begin X tq := typeof(tp^.taparm); X txtfile := tq = typnods[ttext]; X if (not txtfile) and (tq^.tt = nfileof) then X if typeof(tq^.tof) = typnods[tchar] then X txtfile := true; X if txtfile then X if td = dreset then X write('Resetx(') X else X write('Rewritex(') X else X if td = dreset then X write('Reset(') X else X write('Rewrite('); X eexpr(tp^.taparm); X write(', '); X tq := tp^.taparm^.tnext; X if tq = nil then X write('NULL') X else begin X tq := typeof(tq); X if tq = typnods[tchar] then X begin X write(cite); X ch := chr(cvalof(tp^.taparm^.tnext)); X if (ch = bslash) or (ch = cite) then X write(bslash); X write(ch, cite) X end X else if tq = typnods[tstring] then X eexpr(tp^.taparm^.tnext) X else if tq^.tt in [narray, nconfarr] then X begin X eexpr(tp^.taparm^.tnext); X write('.A') X end X else X fatal(etree) X end; X writeln(');') X end; X darctan: X begin X write('atan('); (* LIB *) X if typeof(tp^.taparm) <> typnods[treal] then X write(dblcast); X eexpr(tp^.taparm); X write(')') X end; X dln: X begin X write('log('); (* LIB *) X if typeof(tp^.taparm) <> typnods[treal] then X write(dblcast); X eexpr(tp^.taparm); X write(')') X end; X dexp: X begin X write('exp('); (* LIB *) X if typeof(tp^.taparm) <> typnods[treal] then X write(dblcast); X eexpr(tp^.taparm); X write(')') X end; X dcos, X dsin, X dsqrt: X begin X eexpr(tp^.tcall); (* LIB *) X write('('); X if typeof(tp^.taparm) <> typnods[treal] then X write(dblcast); X eexpr(tp^.taparm); X write(')') X end; X dtan: X begin X write('atan('); (* LIB *) X if typeof(tp^.taparm) <> typnods[treal] then X write(dblcast); X eexpr(tp^.taparm); X write(')') X end; X dsucc, X dpred: X begin X tq := typeof(tp^.taparm); X if tq^.tt = nsubrange then X if tq^.tup^.tt = nconfarr then X tq := typeof(tq^.tup^.tindtyp) X else X tq := typeof(tq^.tlo); X if (tq = typnods[tinteger]) or X (tq = typnods[tchar]) then X begin X write('(('); X eexpr(tp^.taparm); X if td = dpred then X write(')-1)') X else X write(')+1)') X end X else begin X (* some sort of scalar type, casting needed *) X write('('); X tq := tq^.tup; X if tq^.tt = ntype then X begin X (* cast only if it is a named type *) X write('('); X printid(tq^.tidl^.tsym^.lid); X write(')') X end; X write('((int)('); X eexpr(tp^.taparm); X if td = dpred then X write(')-1))') X else X write(')+1))') X end X end; X dodd: X begin X write('('); X printid(defnams[dboolean]^.lid); X write(')(('); X eexpr(tp^.taparm); X write(') & 1)') X end; X dsqr: X begin X tq := typeof(tp^.taparm); X if (tq = typnods[tinteger]) or (tq^.tt = nsubrange) then X begin X write('(('); X eexpr(tp^.taparm); X write(') * ('); X eexpr(tp^.taparm); X write('))') X end X else begin X write('pow('); (* LIB *) X if typeof(tp^.taparm) <> typnods[treal] then X write(dblcast); X eexpr(tp^.taparm); X write(', 2.0)') X end X end; X dround: X begin X write('Round('); X eexpr(tp^.taparm); X write(')') X end; X dtrunc: X begin X write('Trunc('); X eexpr(tp^.taparm); X write(')') X end; X dpack: X begin X tq := typeof(tp^.taparm); X tx := typeof(tp^.taparm^.tnext^.tnext); X write('{ ', registr, inttyp, tab1, '_j, _i = '); X if not arithexpr(tp^.taparm^.tnext) then X write('(int)'); X eexpr(tp^.taparm^.tnext); X if tx^.tt = narray then X write(' - ', clower(tq^.taindx):1); X writeln(';'); X indent; X write(' for (_j = 0; _j < '); X if tq^.tt = nconfarr then X begin X write('(int)('); X printid(tx^.tcindx^.thi^.tsym^.lid); X write(')') X end X else X write(crange(tx^.taindx):1); X writeln('; )'); X indent; X write(tab1); X eexpr(tp^.taparm^.tnext^.tnext); X write('.A[_j++] = '); X eexpr(tp^.taparm); X writeln('.A[_i++];'); X indent; X writeln('}') X end; X dunpack: X begin X tq := typeof(tp^.taparm); X tx := typeof(tp^.taparm^.tnext); X write('{ ', registr, inttyp, tab1, '_j, _i = '); X if not arithexpr(tp^.taparm^.tnext^.tnext) then X write('(int)'); X eexpr(tp^.taparm^.tnext^.tnext); X if tx^.tt <> nconfarr then X write(' - ', clower(tx^.taindx):1); X writeln(';'); X indent; X write(' for (_j = 0; _j < '); X if tq^.tt = nconfarr then X begin X write('(int)('); X printid(tq^.tcindx^.thi^.tsym^.lid); X write(')') X end X else X write(crange(tq^.taindx):1); X writeln('; )'); X indent; X write(tab1); X eexpr(tp^.taparm^.tnext); X write('.A[_i++] = '); X eexpr(tp^.taparm); X writeln('.A[_j++];'); X indent; X writeln('}') X end; X end (* case *) X end; (* epredef *) X X procedure eaddr(tp : treeptr); X X begin X write('&'); X if not(tp^.tt in [nid, nselect, nindex, nderef]) then X error(evarpar); X eexpr(tp) X end; X X (* Emit code for a subroutine call. *) X procedure ecall(tp : treeptr); X X var tf, tq, tx : treeptr; X X begin X (* find first formal parameter id *) X tf := idup(tp^.tcall); X case tf^.tt of X nproc, X nfunc: X tf := tf^.tsubpar; X nparproc, X nparfunc: X tf := tf^.tparparm X end;(* case *) X if tf <> nil then X begin X case tf^.tt of X nvalpar, X nvarpar: X tf := tf^.tidl; X nparproc, X nparfunc: X tf := tf^.tparid X end (* case *) X end; X (* emit called function name *) X eexpr(tp^.tcall); X write('('); X (* emit actual parameters *) X tq := tp^.taparm; X while tq <> nil do X begin X if tf^.tup^.tt in [nparfunc, nparproc] then X begin X (* single subroutine-nid converted to ncall *) X if tq^.tt = ncall then X printid(tq^.tcall^.tsym^.lid) X else X printid(tq^.tsym^.lid) X end X else begin X tx := typeof(tq); X if tx = typnods[tboolean] then X begin X tx := tq; X while tx^.tt = nuplus do X tx := tx^.texps; X if tx^.tt in [nin .. nor, nand, nnot] X then X begin X write('('); X printid(defnams[dboolean]^.lid); X write(')('); X eexpr(tq); X write(')') X end X else X eexpr(tq); X end X else if (tx = typnods[tstring]) or X (tx = typnods[tset]) then X begin X (* cast literal to proper type *) X write('*(('); X etypedef(tf^.tup^.tbind); X write(' *)'); X if tx = typnods[tset] then X begin X dropset := true; X eexpr(tq); X dropset := false X end X else X eexpr(tq); X write(')') X end X else if tx = typnods[tnil] then X begin X write('('); X etypedef(tf^.tup^.tbind); X write(')NIL') X end X else if tf^.tup^.tbind^.tt = nconfarr then X begin X write('(struct '); X printid(tf^.tup^.tbind^.tcuid); X write(' *)&'); X eexpr(tq); X (* add upper bound of actual value *) X if tq^.tnext = nil then X write(', ', X crange(tx^.taindx):1) X end X else begin X if tf^.tup^.tt = nvarpar then X eaddr(tq) X else X eexpr(tq) X end X end; X tq := tq^.tnext; X if tq <> nil then X begin X write(', '); X (* next formal parameter *) X if tf^.tnext = nil then X begin X tf := tf^.tup^.tnext; X case tf^.tt of X nvalpar, X nvarpar: X tf := tf^.tidl; X nparproc, X nparfunc: X tf := tf^.tparid X end (* case *) X end X else X tf := tf^.tnext; X end; X end; X write(')') X end; (* ecall *) X X (* Emit code for a general expression. *) X procedure eexpr; X X label 999; X X var tq : treeptr; X flag : boolean; X X function constset(tp : treeptr) : boolean; X X function constxps(tp : treeptr) : boolean; X begin X case tp^.tt of X nrange: X if constxps(tp^.texpr) then X constxps := constxps(tp^.texpl) X else X constxps := false; X nempty, X ninteger, X nchar: X constxps := true; X nid: X begin X tp := idup(tp); X constxps := (tp^.tt = nconst) X or (tp^.tt = nscalar) X end; X nin, neq, nne, nlt, nle, ngt, nge, nor, X nplus, nminus, nand, nmul, ndiv, nmod, X nquot, nnot, numinus, nuplus, nset, X nindex, nselect, nderef, ncall, X nreal, nstring, nnil: X constxps := false X end (* case *) X end; X X begin X constset := true; X while tp <> nil do X if constxps(tp) then X tp := tp^.tnext X else begin X constset := false; X tp := nil X end X end; X X begin (* eexpr *) X donearr := false; X if tp^.tt in [nplus, nminus, nmul, nle, nge, neq, nne] then X begin X tq := typeof(tp^.texpl); X if (tq^.tt in [nset, nsetof]) or X (tq = typnods[tset]) then X begin X (* set operations *) X case tp^.tt of X nplus: X begin X setused := true; X useunion := true; X write('Union') X end; X nminus: X begin X setused := true; X usediff := true; X write('Diff') X end; X nmul: X begin X setused := true; X useintr := true; X write('Inter') X end; X neq: X begin X useseq := true; X write('Eq') X end; X nne: X begin X usesne := true; X write('Ne') X end; X nge: X begin X usesge := true; X write('Ge') X end; X nle: X begin X usesle := true; X write('Le') X end X end;(* case *) X if tp^.tt in [nplus, nminus, nmul] then X dropset := false; X write('('); X eexpr(tp^.texpl); X if tq^.tt = nsetof then X write('.S'); X write(', '); X eexpr(tp^.texpr); X tq := typeof(tp^.texpr); X if tq^.tt = nsetof then X write('.S'); X write(')'); X goto 999 X end X end; X if tp^.tt in [neq, nne, ngt, nlt, nge, nle] then X begin X tq := typeof(tp^.texpl); X if tq^.tt = nconfarr then X fatal(ecmpconf); X if (tq^.tt in [nstring, narray]) or X (tq = typnods[tstring]) then X begin X write('Cmpstr('); X eexpr(tp^.texpl); X if tq^.tt = narray then X write('.A'); X write(', '); X tq := typeof(tp^.texpr); X if tq^.tt = nconfarr then X fatal(ecmpconf); X eexpr(tp^.texpr); X if tq^.tt = narray then X write('.A'); X write(')'); X case tp^.tt of X neq: X write(' == '); X nne: X write(' != '); X ngt: X write(' > '); X nlt: X write(' < '); X nge: X write(' >= '); X nle: X write(' <= '); X end;(* case *) X write('0'); X goto 999 X end X end; X case tp^.tt of X neq, nne, nlt, nle, X ngt, nge, nor, nand, nplus, nminus, X nmul, ndiv, nmod, nquot: X begin X flag := cprio[tp^.tt] > cprio[tp^.texpl^.tt]; X if (tp^.tt in [nlt, nle, ngt, nge]) and X not arithexpr(tp^.texpl) then X begin X write('(int)'); X flag := true X end; X if flag then X write('('); X eexpr(tp^.texpl); X if flag then X write(')'); X case tp^.tt of X neq: X write(' == '); X nne: X write(' != '); X nlt: X write(' < '); X nle: X write(' <= '); X ngt: X write(' > '); X nge: X write(' >= '); X nor: X write(' || '); X nand: X write(' && '); X nplus: X write(' + '); X nminus: X write(' - '); X nmul: X write(' * '); X ndiv: X write(' / '); X nmod: X write(' % '); X nquot: X begin X write(' / (('); X printid(defnams[dreal]^.lid); X write(')') X end X end;(* case *) X flag := cprio[tp^.tt] > cprio[tp^.texpr^.tt]; X if (tp^.tt in [nlt, nle, ngt, nge]) and X not arithexpr(tp^.texpr) then X begin X write('(int)'); X flag := true X end; X if flag then X write('('); X eexpr(tp^.texpr); X if flag then X write(')'); X if tp^.tt = nquot then X write(')') X end; X X nuplus, numinus, nnot: X begin X case tp^.tt of X numinus: X write('-'); X nnot: X write('!'); X nuplus: X end;(* case *) X flag := cprio[tp^.tt] >= cprio[tp^.texps^.tt]; X if flag then X write('('); X eexpr(tp^.texps); X if flag then X write(')'); X end; X X nin: X begin X usememb := true; X write('Member((unsigned)('); X eexpr(tp^.texpl); X write('), '); X dropset := true; (* no need to save set-expr *) X eexpr(tp^.texpr); X dropset := false; X tq := typeof(tp^.texpr); X if tq^.tt = nsetof then X write('.S'); X write(')') X end; X X nassign: X begin X tq := typeof(tp^.trhs); X if tq = typnods[tstring] then X begin X write(voidcast, 'strncpy('); X eexpr(tp^.tlhs); X write('.A, '); X eexpr(tp^.trhs); X write(', sizeof('); X eexpr(tp^.tlhs); X write('.A))') X end X else if tq = typnods[tboolean] then X begin X eexpr(tp^.tlhs); X write(' = '); X tq := tp^.trhs; X while tq^.tt = nuplus do X tq := tq^.texps; X if tq^.tt in [nin .. nor, nand, nnot] then X begin X write('('); X printid(defnams[dboolean]^.lid); X write(')('); X eexpr(tq); X write(')') X end X else X eexpr(tq) X end X else if tq = typnods[tnil] then X begin X eexpr(tp^.tlhs); X write(' = ('); X etypedef(typeof(tp^.tlhs)); X write(')NIL') X end X else begin X tq := typeof(tp^.tlhs); X if tq^.tt = nsetof then X begin X usescpy := true; X write('Setncpy('); X eselect(tp^.tlhs); X write('S, '); X dropset := true; X tq := typeof(tp^.trhs); X if tq = typnods[tset] then X eexpr(tp^.trhs) X else begin X eselect(tp^.trhs); X write('S') X end; X dropset := false; X write(', sizeof('); X eselect(tp^.tlhs); X write('S))') X end X else begin X eexpr(tp^.tlhs); X write(' = '); X eexpr(tp^.trhs) X end X end X end; X X ncall: X begin X tq := idup(tp^.tcall); X if (tq^.tt in [nfunc, nproc]) and X (tq^.tsubstmt <> nil) then X if tq^.tsubstmt^.tt = npredef then X epredef(tq, tp) X else X ecall(tp) X else X ecall(tp) X end; X X nselect: X begin X eselect(tp^.trecord); X eexpr(tp^.tfield) X end; X nindex: X begin X eselect(tp^.tvariable); X write('A['); X tq := tp^.toffset; X if arithexpr(tq) then X eexpr(tq) X else begin X write('(int)('); X eexpr(tq); X write(')') X end; X tq := typeof(tp^.tvariable); X if tq^.tt = narray then X if clower(tq^.taindx) <> 0 then X begin X write(' - '); X tq := typeof(tq^.taindx); X if tq^.tt = nsubrange then X if arithexpr(tq^.tlo) then X eexpr(tq^.tlo) X else begin X write('(int)('); X eexpr(tq^.tlo); X write(')') X end X else X fatal(etree) X end; X write(']') X end; X nderef: X begin X tq := typeof(tp^.texps); X if (tq^.tt = nfileof) or X ((tq^.tt = npredef) and (tq^.tdef = dtext)) then X begin X (* using a file-variable as pointer *) X eexpr(tp^.texps); X write('.buf') X end X else if doarrow = 0 then X begin X write('*'); X eexpr(tp^.texps) X end X else begin X eexpr(tp^.texps); X write('->'); X donearr := true X end X end; X nid: X begin X (* add pointer-dereference if this id is declared as a X var-parameter or as a procedure-parameter *) X tq := idup(tp); X if tq^.tt = nvarpar then X begin X if (doarrow = 0) or X (tq^.tattr = areference) then X begin X write('(*'); X printid(tp^.tsym^.lid); X write(')') X end X else begin X printid(tp^.tsym^.lid); X write('->'); X donearr := true X end X end X else if (tq^.tt = nconst) and conflag then X write(cvalof(tp):1) X else if tq^.tt in [nparproc, nparfunc] then X begin X write('(*'); X printid(tp^.tsym^.lid); X write(')') X end X else X printid(tp^.tsym^.lid); X end; X nchar: X printchr(tp^.tsym^.lchar); X ninteger: X write(tp^.tsym^.linum:1); X nreal: X printtok(tp^.tsym^.lfloat); X nstring: X printstr(tp^.tsym^.lstr); X nset: X if constset(tp^.texps) then X begin X (* save set expression for initialization *) X write('Conset[', setcnt:1, ']'); X setcnt := setcnt + 1; X tq := mknode(nset); X tq^.tnext := setlst; X setlst := tq; X tq^.texps := tp^.texps X end X else begin X increment; X flag := dropset; X (* if a set-constructor is used in an X expression involving + - * it will need to X be saved temporarily (by Saveset) but often X we can simply forget the set-value when we X have finished using it *) X if dropset then X dropset := false X else X write('Saveset('); X write('(Tmpset = Newset(), '); X tq := tp^.texps; X while tq <> nil do X begin X case tq^.tt of X nrange: X begin X usemksub := true; X write(voidcast, 'Mksubr('); X write('(unsigned)('); X eexpr(tq^.texpl); X write('), '); X write('(unsigned)('); X eexpr(tq^.texpr); X write('), Tmpset)') X end; X nin, neq, nne, nlt, nle, ngt, nge, X nor, nand, nmul, ndiv, nmod, nquot, X nplus, nminus, nnot, numinus, nuplus, X nindex, nselect, nderef, ncall, X ninteger, nchar, nid: X begin X useins := true; X write(voidcast, 'Insmem('); X write('(unsigned)('); X eexpr(tq); X write('), Tmpset)') X end X end;(* case *) X tq := tq^.tnext; X if tq <> nil then X begin X writeln(','); X indent X end X end; X write(', Tmpset)'); X if not flag then X begin X write(')'); X setused := true X end; X decrement X end; X nnil: X begin X tq := tp; X repeat X tq := tq^.tup X until tq^.tt in [neq, nne, ncall, nassign, npgm]; X if tq^.tt in [neq, nne] then X begin X if typeof(tq^.texpl) = typnods[tnil] then X tq := typeof(tq^.texpr) X else X tq := typeof(tq^.texpl); X if tq^.tt = nptr then X begin X write('('); X etypedef(tq); X write(')') X end X end; X write('NIL') X end; X end;(* case *) X 999: X end; (* eexpr *) X X (* Emit constant definitions. *) X procedure econst(tp : treeptr); X X var sp : symptr; X X begin X while tp <> nil do X begin X sp := tp^.tidl^.tsym; X if sp^.lid^.inref > 1 then X sp^.lid := mkrename('X', sp^.lid); X if tp^.tbind^.tt = nstring then X begin X (* string constants emitted as X static local variables *) X indent; X write(static, chartyp, tab1); X printid(sp^.lid); X write('[] = '); X eexpr(tp^.tbind); X writeln(';') X end X else begin X (* all other constants emitted as X preprocessor # defines *) X write(define); X printid(sp^.lid); X write(space); X eexpr(tp^.tbind); X writeln X end; X tp := tp^.tnext X end X end; (* econst *) X X (* Emit a typedef. *) X procedure etypedef; X X (* Workhorse for etypedef, this procedure also *) X (* renames all fields in record-unions when *) X (* necessary. *) X procedure etdef(uid : idptr; tp : treeptr); X X var i : integer; X tq : treeptr; X X (* Emit definition for an integer subrange *) X (* using data from worddefs set up during *) X (* initialization. *) X procedure etrange(tp : treeptr); X X label 999; X X var lo, hi : integer; X i : 1 .. maxmachdefs; X X begin X lo := clower(tp); X hi := cupper(tp); X (* scan CPU word definitions for a type X enclosing wanted range *) X for i := 1 to nmachdefs do X with machdefs[i] do X if (lo >= lolim) and (hi <= hilim) then X begin X (* found it, print type name *) X printtok(typstr); X goto 999 X end; X fatal(erange); X 999: X end; X X (* Print last component of identifier. *) X procedure printsuf(ip : idptr); X X var w : toknbuf; X i, j : toknidx; X X begin X gettokn(ip^.istr, w); X i := 1; X j := i; X while w[i] <> chr(null) do X begin X if w[i] = '.' then X j := i; X i := i + 1 X end; X if w[j] = '.' then X j := j + 1; X while w[j] <> chr(null) do X begin X write(w[j]); X j := j + 1 X end X end; X X begin (* etdef *) X case tp^.tt of X nid: X printid(tp^.tsym^.lid); X nptr: X begin X tq := typeof(tp^.tptrid); X if tq^.tt = nrecord then X begin X write('struct '); X printid(tq^.tuid) X end X else X printid(tp^.tptrid^.tsym^.lid); X write(' *'); X end; X nscalar: X begin X write('enum { '); X increment; X tp := tp^.tscalid; X X (* avoid bug in C-compiler: X enums are mixed in same namespace *) X if tp^.tsym^.lid^.inref > 1 then X tp^.tsym^.lid := X mkrename('E', tp^.tsym^.lid); X printid(tp^.tsym^.lid); X i := 1; X while tp^.tnext <> nil do X begin X if i >= 4 then X begin X writeln(','); X indent; X i := 1 X end X else begin X write(', '); X i := i + 1 X end; X tp := tp^.tnext; X if tp^.tsym^.lid^.inref > 1 then X tp^.tsym^.lid := X mkrename('E', tp^.tsym^.lid); X printid(tp^.tsym^.lid) X end; X decrement; X write(' } ') X end; X nsubrange: X begin X tq := typeof(tp^.tlo); X if tq = typnods[tinteger] then X etrange(tp) X else begin X if tq^.tup^.tt = ntype then X tq := tq^.tup^.tidl; X etdef(nil, tq) X end X end; X nfield: X begin X etdef(nil, tp^.tbind); X write(tab1); X tp := tp^.tidl; X if uid <> nil then X tp^.tsym^.lid := X mkconc('.', uid, tp^.tsym^.lid); X printsuf(tp^.tsym^.lid); X i := 1; X while tp^.tnext <> nil do X begin X if i >= 4 then X begin X writeln(','); X indent; X write(tab1); X i := 1 X end X else begin X write(', '); X i := i + 1 X end; X tp := tp^.tnext; X if uid <> nil then X tp^.tsym^.lid := X mkconc('.', uid, tp^.tsym^.lid); X printsuf(tp^.tsym^.lid); X end; X writeln(';'); X end; X nrecord: X begin X write('struct '); X if tp^.tuid = nil then X tp^.tuid := uid X else if uid = nil then X printid(tp^.tuid); X writeln(' {'); X increment; X if (tp^.tflist = nil) and X (tp^.tvlist = nil) then X begin X (* C doesn't allow empty structures *) X indent; X writeln(inttyp, tab1, 'dummy;') X end; X tq := tp^.tflist; X while tq <> nil do X begin X indent; X etdef(uid, tq); X tq := tq^.tnext X end; X if tp^.tvlist <> nil then X begin X indent; X writeln('union {'); X increment; X tq := tp^.tvlist; X while tq <> nil do X begin X if (tq^.tvrnt^.tflist <> nil) or X (tq^.tvrnt^.tvlist <> nil) then X begin X indent; X if uid = nil then X etdef(mkvrnt, X tq^.tvrnt) X else X etdef(mkconc('.', X uid, mkvrnt), X tq^.tvrnt); X writeln(';') X end; X tq := tq^.tnext X end; X decrement; X indent; X writeln('} U;'); X end; X decrement; X indent; X if tp^.tup^.tt = nvariant then X begin X write('} '); X printsuf(tp^.tuid) X end X else X write('}'); X end; X nconfarr: X begin X write('struct '); X printid(tp^.tcuid); X write(' { '); X etdef(nil, tp^.tcelem); X write(tab1, 'A[]; }') X end; X narray: X begin X write('struct { '); X etdef(nil, tp^.taelem); X write(tab1, 'A['); X tq := typeof(tp^.taindx); X if tq^.tt = nsubrange then X begin X if arithexpr(tq^.thi) then X begin X eexpr(tq^.thi); X if cvalof(tq^.tlo) <> 0 then X begin X write(' - '); X eexpr(tq^.tlo) X end X end X else begin X write('(int)('); X eexpr(tq^.thi); X if cvalof(tq^.tlo) <> 0 then X begin X write(') - (int)('); X eexpr(tq^.tlo) X end; X write(')') X end; X write(' + 1') X end X else X write(crange(tp^.taindx):1); X write(']; }') X end; X nfileof: X begin X writeln('struct {'); X indent; X writeln(tab1, 'FILE', tab1, '*fp;'); X indent; X writeln(tab1, filebits, tab1, 'eoln:1,'); X indent; X writeln(tab3, 'eof:1,'); X indent; X writeln(tab3, 'out:1,'); X indent; X writeln(tab3, 'init:1,'); X indent; X writeln(tab3, ':', filefill:1, ';'); X indent; X write(tab1); X etdef(nil, tp^.tof); X writeln(tab1, 'buf;'); X indent; X write('} ') X end; X nsetof: X write('struct { ', setwtyp, tab1, 'S[', X csetsize(tp):1, ']; }'); X npredef: X begin X case tp^.tobtyp of X tboolean: X printid(defnams[dboolean]^.lid); X tchar: X write(chartyp); X tinteger: X printid(defnams[dinteger]^.lid); X treal: X printid(defnams[dreal]^.lid); X tstring: X write(chartyp, ' *'); X ttext: X write('text'); X tnil, X tset, X terror: X fatal(etree); X tnone: X write(voidtyp); X end (* case *) X end; X nempty: X write(voidtyp); X end;(* case *) X end; (* etdef *) X begin X etdef(nil, tp) X end; (* etypedef *) X X (* Emit code for type declarations. *) X procedure etype(tp : treeptr); X X var sp : symptr; X X begin X while tp <> nil do X begin X (* if identifier used more than once we rename the type X to avoid typedef'ing an identifier twice *) X sp := tp^.tidl^.tsym; X if sp^.lid^.inref > 1 then X sp^.lid := mkrename('Y', sp^.lid); X indent; X write(typdef); X etypedef(tp^.tbind); X write(tab1); X printid(sp^.lid); X writeln(';'); X tp := tp^.tnext X end X end; X X (* Emit code for variable declarations. *) X procedure evar(tp : treeptr); X X label 555; X X var tq : treeptr; X i : integer; X X begin X while tp <> nil do X begin X indent; X case tp^.tt of X nvar, X nvalpar, X nvarpar: X begin X if tp^.tattr = aregister then X write(registr); X etypedef(tp^.tbind) X end; X nparproc, X nparfunc: X begin X if tp^.tt = nparproc then X write(voidtyp) X else X etypedef(tp^.tpartyp); X tq := tp^.tparid; X write(tab1, '(*'); X printid(tq^.tsym^.lid); X write(')()'); X goto 555 X end X end;(* case *) X write(tab1); X tq := tp^.tidl; X i := 1; X repeat X if tp^.tt = nvarpar then X write('*'); X printid(tq^.tsym^.lid); X tq := tq^.tnext; X if tq <> nil then X begin X if i >= 6 then X begin X i := 1; X writeln(','); X indent; X write(tab1) X end X else begin X i := i + 1; X write(', ') X end X END_OF_FILE if test 50280 -ne `wc -c <'ptc.p.3'`; then echo shar: \"'ptc.p.3'\" unpacked with wrong size! fi # end of 'ptc.p.3' fi echo shar: End of archive 9 $of 12$. cp /dev/null ark9isdone MISSING="" for I in 1 2 3 4 5 6 7 8 9 10 11 12 ; do if test ! -f ark${I}isdone ; then MISSING="${MISSING} ${I}" fi done if test "${MISSING}" = "" ; then echo You have unpacked all 12 archives. rm -f ark[1-9]isdone ark[1-9][0-9]isdone else echo You still need to unpack the following archives: echo " " ${MISSING} fi ## End of shell archive. exit 0 -- Rich $alz "Anger is an energy" Cronus Project, BBN Labs rsalz@bbn.com Moderator, comp.sources.unix sources@uunet.uu.net